perm filename CLFZ.OLD[MSS,LCS] blob sn#107272 filedate 1974-06-15 generic text, type T, neo UTF8
C****  CLEFS, JDRAW, CENTR, LINX *********
	SUBROUTINE CLEFS
	IMPLICIT INTEGER(A-Q,S-Z)
	DIMENSION JCLEF(10),MCLEF(600),RCMIN(4)
	REAL DIS,PWDS,DISX,CENTR,POS,STF
	COMMON /STF/RSTFAC(8),RSTJC
	COMMON RJB,JA,CENTR,JB,RJQ(20),JQ(20)
	COMMON/PLTR/PLT,RHT,DIS
      DATA RCMIN/3.3,10.5,7.0,10.5/,JFX/-1/,NAME/0/
	EQUIVALENCE (JD,JQ(2)),(RJD,RJQ(2)),(JE,JQ(3)),(JI,JQ(7))
     1 ,(RJF,RJQ(4)),(RJE,RJQ(3)),(JH,JQ(6)),(RJG,RJQ(5))
	1,(RJI,RJQ(7)),(NJR,RJQ(8))
	DATA NAME/'BDR40'/
	JE=MOD(JE,100)
	JEZ=JE
	IF(JA.EQ.3)GO TO 9
C  YOU MUST TYPE "DRAW" NAME 1ST TIME.  IT'S STICKY.
	IF(NAME.EQ.NJR)GO TO 4
	IF(NAME.NE.0.AND.NJR.EQ.0)GO TO 4
	IF(NJR.EQ.0)GO TO 8
C  TO PICK UP BASIC DRAW NAME FROM P10 
	NAME=NJR
	GO TO 4
8	TYPE 5
	ACCEPT 6,NAME
5	FORMAT(' "DRAW" NAME -- '$)
6	FORMAT(A5)
4	KA=JE/10
C KA LEADS TO PROPER FILE CALL
	NM=NAME+2*KA
C  DRAW0 HAS ITEMS 0→9;  DRAW1, 10→19; ETC. TO DRAW9, 90→99
	JEZ=MOD(JE,10)+1
	GO TO 2
9	NM='CLFX'
2	IF(NM.EQ.JNM)GO TO 30
C  SET P10≠0 TO CHANGE BASIC 'DRAW' NAME.
C  JUMP IF ALREADY IN CORE
	IF(LOOKD(NM))GO TO 1111
	TYPE 1112,NM
	RETURN
1112	FORMAT(1XA5,' -- NOT FOUND')
1111	JNM=NM
	CALL RDDATA(NM,JCLEF,MCLEF)
30	CALL CENTER(CENTR)
C   CHECK THE ABOVE  -- FOR P5 HEIGHT CHANGE *********************
	CALL NOZERO(RJF)
	IF(RJG.EQ.0)RJG=RJF
C  IF P7 = 0, IT WILL EQUAL P6.
C  RJF IS SIZE FACTOR
	IF(JE.GT.4.OR.JA.NE.3)GO TO 811
	IF(JEZ.EQ.0)JEZ=1
	IF(RJE.LT.100)GO TO 812
	RSTJC=.8*RSTJC
	CENTR=CENTR+RCMIN(JEZ)*RSTJC
C  TO SET HGT. OF MINI CLEFS
812	IF(JEZ.NE.4)GO TO 811
	CENTR=CENTR+RSTJC*14
	JEZ=3
C   ABOVE IS NOW AT TOP
811	L=JCLEF(JEZ)
	IF(JI.NE.0)CALL ROTATE(MCLEF,L)
C  RJI=P9=DEGREES OF ROTATION (0-360)
	CALL JDRAW(MCLEF(L),RJB,CENTR,RSTJC,RJF,RJG)
C   3,POS.,STF,NT# OR CLEF,ITEM#,SIZEX,SIZEY, JH=-1 TO FILL ON CRT
C			JH=-2 OMITS FILLER DURING PLOT

	N=0
	JD=MCLEF(L)+L
	IF(MCLEF(JD).EQ.999)N=JD+1
1	IF(N.NE.0.AND.JH.NE.-2.AND.(PLT.OR.JH))CALL OLDFIL(MCLEF(N),
	1 RJB,CENTR,RJF,RJG)
	IF((JH.EQ.-2.AND.PLT).OR.(JH.NE.-1.AND.PLT.GE.0))GO TO 7
	DO 3 K=L+1,MCLEF(L)+L
	IF(MCLEF(K).LT.200000000)GO TO 3
	JD=MCLEF(L)-1
	IF(K.GT.L+1)JD=JD-K+L+1
	CALL FILLMS(JD,MCLEF(K),RJB,CENTR,RJF,RJG)
	GO TO 7
3	CONTINUE
CC7	IF(JI.NE.0)CALL UNROT(MCLEF(L))
C  FILLS ONLY WHEN PLOTING OR RJG=-1
7	END

	SUBROUTINE JDRAW(M,RJB,CENTR,RSTJC,RX,RY)
	COMMON/LL/LL
	DIMENSION M(1)
	RC=RX*RSTJC
	RD=RY*RSTJC
	DO 2 K=2,M(1)
	CALL UNPACK(IA,IB,M(K))
CC	RA=IA*RC+RJB
CC	RB=IB*RD+CENTR
CC	IF(K.EQ.I)LL=3
CC2	CALL LINES(RA,RB,LL)
2	CALL LINES(FLOAT(IA)*RC+RJB,FLOAT(IB)*RD+CENTR,LL)
	END

	SUBROUTINE CENTER(CNTR)
C  TO CENTER ITEMS CREATED WITH DRAWING PROG.
	COMMON /STF/RSTFAC(8),RSTJC
	COMMON RJB,JA,CENTR,JB,RJQ(20),JQ(20)
	COMMON/POSI/STF(8),JJB,POS
	EQUIVALENCE (RJD,RJQ(2))
	CNTR=POS+(2+AMOD(RJD,100.)*7)*RSTJC
	END

	SUBROUTINE LINX(A,B,C,D)
C  SAVES SPACE FOR SINGLE LINES.
	CALL LINES(A,B,3)
	CALL LINES(C,D,2)
	END